home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / runtime / extern.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-03  |  3.5 KB  |  153 lines  |  [TEXT/R*ch]
  1. /* Structured output, fast format */
  2.  
  3. #include "debugger.h"
  4. #include "fail.h"
  5. #include "gc.h"
  6. #include "intext.h"
  7. #include "io.h"
  8. #include "memory.h"
  9. #include "mlvalues.h"
  10.  
  11. struct extern_obj * extern_table;
  12. asize_t extern_table_size, extern_table_used;
  13.  
  14. void alloc_extern_table()
  15. {
  16.   asize_t i;
  17.  
  18.   extern_table = (struct extern_obj *)
  19.     stat_alloc(extern_table_size * sizeof(struct extern_obj));
  20.   for (i = 0; i < extern_table_size; i++)
  21.     extern_table[i].obj = 0;
  22. }
  23.  
  24. void resize_extern_table()
  25. {
  26.   asize_t oldsize;
  27.   struct extern_obj * oldtable;
  28.   asize_t i, h;
  29.  
  30.   oldsize = extern_table_size;
  31.   oldtable = extern_table;
  32.   extern_table_size = 2 * extern_table_size;
  33.   alloc_extern_table();
  34.   for (i = 0; i < oldsize; i++) {
  35.     h = Hash(oldtable[i].obj);
  36.     while (extern_table[h].obj != 0) {
  37.       h++;
  38.       if (h >= extern_table_size) h = 0;
  39.     }
  40.     extern_table[h].obj = oldtable[i].obj;
  41.     extern_table[h].ofs = oldtable[i].ofs;
  42.   }
  43.   stat_free((char *) oldtable);
  44. }
  45.  
  46. static byteoffset_t * extern_block;
  47. static asize_t extern_size, extern_pos;
  48.  
  49. static void resize_result()
  50. {
  51.   extern_size = 2 * extern_size;
  52.   extern_block = (byteoffset_t *)
  53.     stat_resize((char *) extern_block, extern_size * sizeof(byteoffset_t));
  54. }
  55.  
  56. static byteoffset_t emit(v)
  57.      value v;
  58. {
  59.   mlsize_t size;
  60.   asize_t h;
  61.   byteoffset_t res;
  62.   value * p;
  63.   byteoffset_t * q;
  64.   asize_t end_pos;
  65.  
  66.   if (Is_long(v)) return (byteoffset_t) v;
  67.   size = Wosize_val(v);
  68.   if (size == 0) return (Tag_val(v) << 2) + 2;
  69.   if (2 * extern_table_used >= extern_table_size) resize_extern_table();
  70.   h = Hash(v);
  71.   while (extern_table[h].obj != 0) {
  72.     if (extern_table[h].obj == v) return extern_table[h].ofs;
  73.     h++;
  74.     if (h >= extern_table_size) h = 0;
  75.   }
  76.   end_pos = extern_pos + 1 + size;
  77.   while (end_pos >= extern_size) resize_result();
  78.   extern_block[extern_pos++] = Hd_val(v);
  79.   res = extern_pos * sizeof(byteoffset_t);
  80.   extern_table[h].obj = v;
  81.   extern_table[h].ofs = res;
  82.   extern_table_used++;
  83.   for (p = &Field(v, 0), q = &extern_block[extern_pos]; size > 0; size--) {
  84.     *q++ = *p++;
  85.   }
  86.   extern_pos = end_pos;
  87.   return res;
  88. }
  89.  
  90. static byteoffset_t emit_all(root)
  91.      value root;
  92. {
  93.   asize_t read_pos;
  94.   byteoffset_t res;
  95.   header_t hd;
  96.   mlsize_t sz;
  97.   byteoffset_t ofs;
  98.  
  99.   read_pos = extern_pos;
  100.   res = emit(root);
  101.   while (read_pos < extern_pos) {
  102.     hd = (header_t) extern_block[read_pos++];
  103.     sz = Wosize_hd(hd);
  104.     switch(Tag_hd(hd)) {
  105.     case String_tag:
  106.     case Double_tag:
  107.       read_pos += sz;
  108.       break;
  109.     case Abstract_tag:
  110.     case Final_tag:
  111.       invalid_argument("output_value: abstract value");
  112.       break;
  113.     case Closure_tag:
  114.       invalid_argument("output_value: functional value");
  115.       break;
  116.     default:
  117.       while (sz > 0) {
  118.         ofs = emit((value) extern_block[read_pos]);
  119.         extern_block[read_pos] = ofs;
  120.         read_pos++;
  121.         sz--;
  122.       }
  123.       break;
  124.     }
  125.   }
  126.   return res;
  127. }
  128.  
  129. value extern_val(chan, v)       /* ML */
  130.      struct channel * chan;
  131.      value v;
  132. {
  133.   byteoffset_t res;
  134.  
  135.   extern_size = INITIAL_EXTERN_SIZE;
  136.   extern_block =
  137.     (byteoffset_t *) stat_alloc(extern_size * sizeof(unsigned long));
  138.   extern_pos = 0;
  139.   extern_table_size = INITIAL_EXTERN_TABLE_SIZE;
  140.   alloc_extern_table();
  141.   extern_table_used = 0;
  142.   res = emit_all(v);
  143.   stat_free((char *) extern_table);
  144.   putword(chan, Extern_magic_number);
  145.   putword(chan, extern_pos);
  146.   if (extern_pos == 0)
  147.     putword(chan, res);
  148.   else
  149.     putblock(chan, (char *) extern_block, extern_pos * sizeof(unsigned long));
  150.   stat_free((char *) extern_block);
  151.   return Val_unit;
  152. }
  153.